MacWorld 1999 January - Disc 2/Macworld (1999-01) (Disk 2).dmg/Serious Demos/Symbolic Composer 4.2/Environment/Projects/Examples/Demos/Array 4

Lisp/Scheme | 1998-10-26 | 5KB | 405 lines

;;; Song - movement VI from Array for solo violin
; by Nigel Morgan
; to analyze the score double-click high-lighted keywords

;; material

(setq fig '(a -b -e -c -d -g))
(setq fig0 (append '(=) fig '(=)))
(setq figcd '(= = -g -d -c -e -b a)) ; coda
(setq figx '(a = = -b -e -c -d -g)) ; rhythmic version

(setq frh '(1/4. 1/8 1/8 1/8 1/8 1/8))
(setq frh0 (append '(1/4) frh '(1/4)))
(setq frhcd (mapcar 'get-tick
                    '(1/4 1/4-5 1/4-5 1/4-5 1/4-5 1/4-5 1/4. 1/8)))

(setq fdy '(0 70 62 54 64 52 44 0))

;; definitions

(initdef)

(defsym a  '(= = -b))
(defsym -b '(-e -c))
(defsym -e '(-c -d))
(defsym -c '(-d -g a))
(defsym -d '(-g a = =))
(defsym -g '(a = = -b))

;; verse

(setq fig1 (gen-trans a 4)
      fig2 (gen-trans -b 4)
      fig3 (gen-trans -e 4)
      fig4 (gen-trans -c 4)
      fig5 (gen-trans -d 4)
      fig6 (gen-trans -g 4)
)

(def-neuron rhythms
  (in 1 '(b -b c b b b -c e)) (cons-n '1/32 8)
  (in 1 '(d -b -d e)) (cons-n '1/32 4)
  (otherwise '1/16))

;; chorus

(setq figr1 (append '(=) (symbol-scroll -1 fig) '(=))
      figr2 (append '(=) (symbol-scroll -2 fig) '(=))
      figr3 (append '(=) (symbol-scroll -3 fig) '(=))
      figr4 (append '(=) (symbol-scroll -4 fig) '(=))
      figr5 (append '(=) (symbol-scroll -5 fig) '(=))
)

(setq frh1 (append '(1/4) (symbol-scroll -1 frh) '(1/4))
      frh2 (append '(1/4) (symbol-scroll -2 frh) '(1/4))
      frh3 (append '(1/4) (symbol-scroll -3 frh) '(1/4))
      frh4 (append '(1/4) (symbol-scroll -4 frh) '(1/4))
      frh5 (append '(1/4) (symbol-scroll -5 frh) '(1/4))
)

;; score

(def-tonality
  violin (activate-tonality (chromatic a& 5))
)

(def-symbol
  violin (list fig0 fig1
               figr1 fig2
               figr2 fig3
               figr3 fig4
               figr4 fig5
               figr5 fig6
               figcd)

)

(def-length
  violin (symbol-interleave
          (list frh0 frh1
                frh2 frh3
                frh4 frh5
                frhcd)
          (mapcar
           (function (lambda (x)
                       (run-neuron 'rhythms x)))
           (list fig1 fig2
                 fig3 fig4
                 fig5 fig6)))
)

(def-zone
  violin (mapcar 'make-zone (get-lengths-of 'violin))
)

(def-velocity
  violin (symbol-interleave
          (cons-n fdy 7)
          (gen-process
           '(vector-to-list
             (vector-round 36 70
                           (gen-noise-white x y)))
           (delete '8
                   (mapcar 'length
                           (get-symbols-of 'violin))) nil :list))
)

(def-channel
 violin 1
)

(def-program gm-sound-set
 violin violin
)

(def-tempo 70)

(midiport :printer)

(compile-instrument-p "ccl;output:" "Array 4 midi"
  violin
)

#|

(listdef a 4)

 a
  =
  =
  -b
    -e
      -c
        -d
        -g
        a
      -d
        -g
        a
        =
        =
    -c
      -d
        -g
        a
        =
        =
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
nil

(listdef -b)

-b
  -e
    -c
      -d
        -g
        a
        =
        =
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
    -d
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
      =
      =
  -c
    -d
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
      =
      =
    -g
      a
        =
        =
        -b
      =
      =
      -b
        -e
        -c
    a
      =
      =
      -b
        -e
        -c
nil

(listdef -e 4)

 -e
  -c
    -d
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
      =
      =
    -g
      a
        =
        =
        -b
      =
      =
      -b
        -e
        -c
    a
      =
      =
      -b
        -e
        -c
  -d
    -g
      a
        =
        =
        -b
      =
      =
      -b
        -e
        -c
    a
      =
      =
      -b
        -e
        -c
    =
    =
nil

(listdef -c 4)

 -c
  -d
    -g
      a
        =
        =
        -b
      =
      =
      -b
        -e
        -c
    a
      =
      =
      -b
        -e
        -c
    =
    =
  -g
    a
      =
      =
      -b
        -e
        -c
    =
    =
    -b
      -e
        -c
        -d
      -c
        -d
        -g
        a
  a
    =
    =
    -b
      -e
        -c
        -d
      -c
        -d
        -g
        a
nil

(listdef -d 4)

-d
  -g
    a
      =
      =
      -b
        -e
        -c
    =
    =
    -b
      -e
        -c
        -d
      -c
        -d
        -g
        a
  a
    =
    =
    -b
      -e
        -c
        -d
      -c
        -d
        -g
        a
  =
  =
nil

(listdef -g 4)

 -g
  a
    =
    =
    -b
      -e
        -c
        -d
      -c
        -d
        -g
        a
  =
  =
  -b
    -e
      -c
        -d
        -g
        a
      -d
        -g
        a
        =
        =
    -c
      -d
        -g
        a
        =
        =
      -g
        a
        =
        =
        -b
      a
        =
        =
        -b
nil

|#